perm filename DDERIV.BCH[TIM,LSP] blob sn#717362 filedate 1983-06-29 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00007 ENDMK
CāŠ—;

(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))

(DEFUN (PLUS DERIV) (A)
       (CONS 'PLUS (MAPCAR 'DERIV A)))

(DEFUN (DIFFERENCE DERIV) (A)
       (CONS 'DIFFERENCE (MAPCAR 'DERIV 
				 A)))

(DEFUN (TIMES DERIV) (A)
	(LIST 'TIMES (CONS 'TIMES A)
		(CONS 'PLUS (MAPCAR 'DER1 A))))

(DEFUN (QUOTIENT DERIV) (A)
       (LIST 'DIFFERENCE 
	     (LIST 'QUOTIENT 
		   (DERIV (CAR A)) 
		   (CADR A))
	     (LIST 'QUOTIENT 
		   (CAR A) 
		   (LIST 'TIMES
			 (CADR A)
			 (CADR A)
			 (DERIV (CADR A))))))

;;; FUNCALL (for the 1 argument case) can be defined as:
;;;	(DEFUN FUNCALL (F X)
;;;	 	(APPLY F (NCONS X)))
;;;
;;; Using macros FUNCALL is (in the general case):
;;;  	(DEFMACRO FUNCALL (F . X)
;;;		`(APPLY ,F (LIST . ,X)))

 (DEFUN DERIV (A)
	(COND 
	 ((ATOM A)
	  (COND ((EQ A 'X) 1) (T 0)))
	 (T (LET ((DERIV (GET (CAR A) 'DERIV)))
		 (COND (DERIV (FUNCALL DERIV (CDR A)))
		       (T 'ERROR))))))

(DEFUN RUN ()
 (DECLARE (FIXNUM I))
 (DO ((I 0 (1+ I)))
     ((= I 1000.))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))

Here is a sample run on SAIL in MacLisp:
(fasload dderiv)
(timit)

Timing performed on Tuesday 07/06/82 at 16:01:46.
Cpu Time = 3.12
Elapsed Time = 66.9
Wholine Time = 39.233333
GC Time = 18.734
Load Average Before  = 1.03375137
Load Average After   = 1.3326118
Average Load Average = 1.18318158

Refer to this benchmark as DDERIV.
			-rpg-